ohibc logo
OHI British Columbia | OHI Science | Citation policy

knitr::opts_chunk$set(fig.width = 6, fig.height = 4, fig.path = 'Figs/',
                      echo = TRUE, message = FALSE, warning = FALSE)

library(ohicore) ### devtools::install_github('ohi-science/ohicore')

source('~/github/ohibc/src/R/common.R')

dir_ohibc  <- '~/github/ohibc'
dir_calc   <- file.path(dir_ohibc, 'calc_ohibc')
dir_master <- file.path(dir_calc, 'master')

source(file.path(dir_calc, 'calc_scores_fxns.R'))

### provenance tracking
# library(provRmd); prov_setup()

1 Pressure plots

1.1 Overall pressures by goal and region

prs_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
  filter(dimension %in% c('pressures')) %>%
  left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))

for(goalname in prs_scores$goal %>% unique() %>% sort) {
  # goalname <- prs_scores$goal[1]
  scores_tmp <- prs_scores %>%
    filter(goal == goalname)
  prs_plot <- ggplot(scores_tmp %>% 
                          filter(region_id != 0), 
                      aes(x = year, y = score, color = rgn_name)) +
    ggtheme_plot() +
    geom_line(aes(group = region_id), alpha = .7, size = 1.5) +
    scale_x_continuous(breaks = scores_tmp$year[scores_tmp$year %% 5 == 0] %>% 
                         unique() %>% 
                         sort) +
    scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
                                  brewer.pal(n = 8, name = 'Pastel2'),
                                  'purple4', 'orange4', 'blue4')) +
    # scale_y_continuous(limits = c(-1, 1)) +
    labs(color = paste0('Prs: ', goalname),
         y     = paste0('Pressure on ', goalname)) +
    guides(colour = guide_legend(override.aes = list(size = 3)))

  print(prs_plot)
}

1.2 Pressure layers by goal and region

prs_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
  filter(dimension %in% c('pressures', 'resilience', 'status')) %>%
  filter(region_id != 0) %>%
  filter(!goal %in% c('FP', 'BD', 'ES', 'SP', 'Index')) %>%
  spread(dimension, score) %>%
  left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))

prs_layers <- read_csv(file.path(dir_calc, 'checks/layers_full_list.csv')) %>%
  filter(dimension == 'pressure') %>%
  filter(!str_detect(layer, 'element_wt')) %>%
  filter(!is.na(dir_prep)) %>%
  select(layer, target, target_element, dir_prep, filename, name_data_fld) %>%
  distinct()

prs_files <- prs_layers %>%
  select(layer, dir_prep, filename, name_data_fld) %>%
  mutate(dir_prep = str_replace(dir_prep, 'ohibc:', '~/github/ohibc/')) %>%
  distinct() 

prs_data <- lapply(seq_along(prs_files$layer), FUN = function(i) {
    ### i <- 12
    x <- read_csv(file.path(prs_files$dir_prep[i], prs_files$filename[i])) %>%
      rename_('pressure' = prs_files$name_data_fld[i])
  }) %>%
  setNames(prs_files$layer) %>%
  bind_rows(.id = 'layer') %>%
  select(layer, rgn_id, year, pressure)

prs_data_all <- prs_data %>%
  filter(is.na(year)) %>%
  group_by(layer, rgn_id) %>%
  mutate(year = 2016) %>%
  complete(year = 2000:2016) %>%
  fill(pressure, .direction = 'up') %>%
  ungroup() %>%
  bind_rows(prs_data %>%
              filter(!is.na(year) & year >= 2000)) %>%
  mutate(pressure = 100 * pressure)

for(goalname in prs_scores$goal %>% unique() %>% sort) {
  # goalname <- prs_scores$goal[1]
  scores_tmp <- prs_scores %>%
    filter(goal == goalname)
  
  layers_tmp <- prs_layers %>%
    filter(target == goalname) %>%
    left_join(prs_data_all, by = 'layer') %>%
    select(layer, target_element, rgn_id, year, pressure) %>%
    left_join(get_rgn_names(), by = 'rgn_id') %>%
    filter(!is.na(rgn_id)) %>%
    filter(rgn_id %in% scores_tmp$region_id) %>%
    distinct()
  
  if(all(is.na(layers_tmp$target_element))) {
    
    prs_plot <- ggplot(layers_tmp, 
                       aes(x = year, y = pressure, color = layer)) +
      ggtheme_plot() +
      # geom_line(data = scores_tmp %>%
      #                       filter(region_id != 0), 
      #           aes(x = year, y = score), alpha = .7) +
      geom_line(data = scores_tmp, aes(y = pressures),  color = 'darkred',   alpha = .2, size = 2) +
      geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
      geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
      geom_line(aes(group = layer), alpha = 1, size = .5) +
      scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>% 
                           unique() %>% 
                           sort) +
      scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
                                    brewer.pal(n = 8, name = 'Pastel2'),
                                    'purple4', 'orange4', 'blue4')) +
      # scale_y_continuous(limits = c(-1, 1)) +
      theme(axis.text.x = element_text(angle = 75)) +
      labs(color = paste0('Prs: ', goalname),
           y = paste0('Pressure on ', goalname)) +
      guides(colour = guide_legend(override.aes = list(size = 3))) +
      facet_wrap( ~ rgn_name)
  
    print(prs_plot)
  } else {
    for(target in layers_tmp$target_element %>% unique()) {
      ### target = layers_tmp$target_element[1]
      layers_target <- layers_tmp %>%
        filter(target_element == target)
      
      prs_plot <- ggplot(layers_target, 
                         aes(x = year, y = pressure, color = layer)) +
        ggtheme_plot() +
        # geom_line(data = scores_tmp %>%
        #                       filter(region_id != 0), 
        #           aes(x = year, y = score), alpha = .7) +
        geom_line(data = scores_tmp, aes(y = pressures),  color = 'darkred',   alpha = .2, size = 2) +
        geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
        geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
        geom_line(aes(group = layer), alpha = 1, size = .5) +
        scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>% 
                             unique() %>% 
                             sort) +
        scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'), 
                                      brewer.pal(n = 8, name = 'Pastel2'), 
                                      'purple4', 'orange4', 'blue4')) +
        # scale_y_continuous(limits = c(-1, 1)) +
        theme(axis.text.x = element_text(angle = 75)) +
        labs(color = paste0('Prs: ', goalname),
             y = paste0('Pressure on ', goalname, ': ', target)) +
        guides(colour = guide_legend(override.aes = list(size = 3))) +
        facet_wrap( ~ rgn_name)
    
      print(prs_plot)
    }
  }
}

2 Resilience plots

res_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
  filter(dimension %in% c('resilience')) %>%
  left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))

for(goalname in res_scores$goal %>% unique() %>% sort) {
  # goalname <- scores$goal[1]
  scores_tmp <- res_scores %>%
    filter(goal == goalname)
  res_plot <- ggplot(scores_tmp %>% 
                          filter(region_id != 0), 
                      aes(x = year, y = score, color = rgn_name)) +
    ggtheme_plot() +
    geom_line(aes(group = region_id), alpha = .7, size = 1.5) +
    scale_x_continuous(breaks = scores_tmp$year[scores_tmp$year %% 5 == 0] %>% 
                         unique() %>% 
                         sort) +
    scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
                                  brewer.pal(n = 8, name = 'Pastel2'),
                                  'purple4', 'orange4', 'blue4')) +
    # scale_y_continuous(limits = c(-1, 1)) +
    labs(color = paste0('Res: ', goalname),
         y     = paste0('Resilience on ', goalname)) +
    guides(colour = guide_legend(override.aes = list(size = 3)))

  print(res_plot)
}

2.1 Resilience layers by goal and region

res_scores <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
  filter(dimension %in% c('pressures', 'resilience', 'status')) %>%
  filter(region_id != 0) %>%
  filter(!goal %in% c('FP', 'BD', 'ES', 'SP', 'Index')) %>%
  spread(dimension, score) %>%
  left_join(get_rgn_names(), by = c('region_id' = 'rgn_id'))

res_layers <- read_csv(file.path(dir_calc, 'checks/layers_full_list.csv')) %>%
  filter(dimension == 'resilience') %>%
  filter(!str_detect(layer, 'element_wt')) %>%
  filter(!is.na(dir_prep)) %>%
  select(layer, target, target_element, dir_prep, filename, name_data_fld) %>%
  distinct()

res_files <- res_layers %>%
  select(layer, dir_prep, filename, name_data_fld) %>%
  mutate(dir_prep = str_replace(dir_prep, 'ohibc:', '~/github/ohibc/')) %>%
  distinct()

res_data <- lapply(seq_along(res_files$layer), FUN = function(i) {
    ### i <- 12
    x <- read_csv(file.path(res_files$dir_prep[i], res_files$filename[i])) %>%
      rename_('pressure' = res_files$name_data_fld[i])
  }) %>%
  setNames(res_files$layer) %>%
  bind_rows(.id = 'layer') %>%
  select(layer, rgn_id, year, pressure)

res_data_all <- res_data %>%
  filter(is.na(year)) %>%
  group_by(layer, rgn_id) %>%
  mutate(year = 2016) %>%
  complete(year = 2000:2016) %>%
  fill(pressure, .direction = 'up') %>%
  ungroup() %>%
  bind_rows(res_data %>%
              filter(!is.na(year) & year >= 2000)) %>%
  mutate(pressure = 100 * pressure)

for(goalname in res_scores$goal %>% unique() %>% sort) {
  # goalname <- res_scores$goal[1]
  scores_tmp <- res_scores %>%
    filter(goal == goalname)
  
  layers_tmp <- res_layers %>%
    filter(target == goalname) %>%
    left_join(res_data_all, by = 'layer') %>%
    select(layer, target_element, rgn_id, year, pressure) %>%
    left_join(get_rgn_names(), by = 'rgn_id') %>%
    filter(!is.na(rgn_id)) %>%
    filter(rgn_id %in% scores_tmp$region_id) %>%
    distinct()
  
  if(all(is.na(layers_tmp$target_element))) {
    
    res_plot <- ggplot(layers_tmp, 
                       aes(x = year, y = pressure, color = layer)) +
      ggtheme_plot() +
      # geom_line(data = scores_tmp %>%
      #                       filter(region_id != 0), 
      #           aes(x = year, y = score), alpha = .7) +
      geom_line(data = scores_tmp, aes(y = pressures),  color = 'darkred',   alpha = .2, size = 2) +
      geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
      geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
      geom_line(aes(group = layer), alpha = 1, size = .5) +
      scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>% 
                           unique() %>% 
                           sort) +
      scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
                                    brewer.pal(n = 8, name = 'Pastel2'),
                                    'purple4', 'orange4', 'blue4')) +
      # scale_y_continuous(limits = c(-1, 1)) +
      theme(axis.text.x = element_text(angle = 75)) +
      labs(color = paste0('Res: ', goalname),
           y = paste0('Resilience on ', goalname)) +
      guides(colour = guide_legend(override.aes = list(size = 3))) +
      facet_wrap( ~ rgn_name)
  
    print(res_plot)
  } else {
    for(target in layers_tmp$target_element %>% unique()) {
      ### target = layers_tmp$target_element[1]
      layers_target <- layers_tmp %>%
        filter(target_element == target)
      
      res_plot <- ggplot(layers_target, 
                         aes(x = year, y = pressure, color = layer)) +
        ggtheme_plot() +
        # geom_line(data = scores_tmp %>%
        #                       filter(region_id != 0), 
        #           aes(x = year, y = score), alpha = .7) +
        geom_line(data = scores_tmp, aes(y = pressures),  color = 'darkred',   alpha = .2, size = 2) +
        geom_line(data = scores_tmp, aes(y = resilience), color = 'darkgreen', alpha = .2, size = 2) +
        geom_line(data = scores_tmp, aes(y = status), color = 'grey30', alpha = .2, size = 2) +
        geom_line(aes(group = layer), alpha = 1, size = .5) +
        scale_x_continuous(breaks = layers_tmp$year[layers_tmp$year %% 5 == 0] %>% 
                             unique() %>% 
                             sort) +
        scale_color_manual(values = c(brewer.pal(n = 8, name = 'Dark2'),
                                      brewer.pal(n = 8, name = 'Pastel2'),
                                      'purple4', 'orange4', 'blue4')) +
        # scale_y_continuous(limits = c(-1, 1)) +
        theme(axis.text.x = element_text(angle = 75)) +
        labs(color = paste0('Res: ', goalname),
             y = paste0('Resilience on ', goalname, ': ', target)) +
        guides(colour = guide_legend(override.aes = list(size = 3))) +
        facet_wrap( ~ rgn_name)
    
      print(res_plot)
    }
  }
}

3 Status vs dimensions plots (overall only)

Dark grey is status; grey dotted is score; red is pressures; green is resilience.

scores_overall <- read_csv(file.path(dir_calc, 'scores_all.csv')) %>%
  filter(dimension != 'future') %>%
  filter(region_id != 0) %>%
  filter(!goal %in% c('Index', 'SP', 'FP', 'BD', 'ES')) %>% ### ditch supragoals
  group_by(goal, dimension, year) %>%
  summarize(mean_score = mean(score, na.rm = TRUE)) %>%
  ungroup() %>%
  spread(dimension, mean_score)

dim_plot <- ggplot(scores_overall, 
                    aes(x = year, y = status)) +
  ggtheme_plot() +
  geom_line(color = 'grey20', alpha = .7, size = 1.5) +
  geom_line(aes(y = score), 
            color = 'grey30', linetype = '1111',alpha = .7, size = 1) +
  geom_line(aes(y = pressures),  color = 'darkred', alpha = .7, size = .5) +
  geom_line(aes(y = resilience), color = 'darkgreen', alpha = .7, size = .5) +
  scale_x_continuous(breaks = scores_tmp$year %>% unique() %>% sort) +
  scale_y_continuous(limits = c(0, 100)) +
  theme(axis.text.x = element_text(angle = 90),
        axis.title.y = element_blank()) +
  facet_wrap( ~ goal)

print(dim_plot)

4 Determine changes in pressure matrix

Several new pressures layers and categories have been added to OHIBC. For the global OHI, pressures scores were determined through expert opinion and carefully referenced; for OHIBC pressures that are unchanged from global, these references should still be valid. For scores or layers that have been adjusted or added, we may need to determine new sources to justify these changes.

prs_ohibc  <- read_csv(file.path(dir_calc, 'master/pressures_matrix_master.csv')) %>%
  select(-element_name) %>%
  gather(pressure, bc_magn, -goal, -element)
prs_global <- read_csv('~/github/ohi-global/eez/conf/pressures_matrix.csv') %>%
  select(-element_name) %>%
  gather(pressure, gl_magn, -goal, -element) %>%
  mutate(element = str_replace(element, 'mangrove', 'coastal_forest')) %>%
    ### closest analog to BC coastal forests
  mutate(goal = ifelse(goal == 'CS', 'CSS', goal),
         goal = ifelse(goal == 'CP', 'CPP', goal),
         goal = ifelse(goal == 'LIV', 'LE', goal))
    ### adjust goal names to match

goal_mismatch <- prs_global %>%
  select(goal, element) %>%
  filter(!goal %in% prs_ohibc$goal | (!is.na(element) & !element %in% prs_ohibc$element)) %>%
  distinct() %>%
  mutate(drop = TRUE)
         
prs_compare <- prs_ohibc %>%
  full_join(prs_global, by = c('goal', 'element', 'pressure')) %>%
  filter(pressure %in% prs_ohibc$pressure) %>%
  filter(!is.na(bc_magn) | !is.na(gl_magn)) %>%
  left_join(goal_mismatch, by = c('goal', 'element')) %>%
  filter(!drop | is.na(drop)) %>%
  select(-drop) %>%
  mutate(delta = case_when(is.na(bc_magn) & !is.na(gl_magn) ~ 'drop',
                           is.na(gl_magn) & !is.na(bc_magn) ~ 'add',
                           bc_magn == gl_magn ~ 'no change',
                           bc_magn < gl_magn  ~ 'reduce',
                           bc_magn > gl_magn  ~ 'increase',
                           TRUE ~ 'missed a case somewhere'))

DT::datatable(prs_compare)